home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok29.lha / DisCopper / Copper.mod < prev    next >
Text File  |  1993-08-15  |  4KB  |  138 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     Copper.mod
  3.     :Contents.      Spielerei und Test für DisCopper und PatchMrg
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.2e
  10.     :History.      V 1.0   May 89   Preusing
  11.     :Imports.      DisCopper 1.0 (Preusing) BackDrop 1.0 (Preusing)
  12.     :Usage.      'Copper'
  13. ---------------------------------------------------------------------------*)
  14. MODULE Copper;
  15.  
  16. FROM SYSTEM    IMPORT    ADR;
  17. FROM Arts    IMPORT    Assert;
  18. FROM Exec    IMPORT    AllocMem, FreeMem, AllocAbs, MemReqs, MemReqSet,
  19.             Forbid, Permit;
  20. FROM Graphics    IMPORT    UCopListPtr, CMove, CWait, CBump, Move, Draw,
  21.             FreeCopList, UCopperListInit;
  22. FROM GfxMacros    IMPORT    CMOVE, CWAIT, CEND;
  23. FROM Intuition    IMPORT    ScreenPtr, OpenWorkBench, RethinkDisplay;
  24. FROM BackDrop    IMPORT    OpenBackDrop, CloseBackDrop, BdRp, BdScreen;
  25. FROM Hardware    IMPORT    custom;
  26. FROM Dos    IMPORT    Delay;
  27. FROM DisCopper    IMPORT    ShowIt;
  28. FROM InOut    IMPORT    WriteString, ReadInt, Read, OpenOutput;
  29.  
  30.  
  31. VAR ActScreen: ScreenPtr;
  32.     U: UCopListPtr;
  33.     DEPTH, WIDTH, HEIGHT, WH:INTEGER;
  34.     OwnS:INTEGER;
  35.     i: INTEGER;
  36.  
  37.  
  38. PROCEDURE MakeUCopList():UCopListPtr;
  39. VAR u: UCopListPtr;
  40. BEGIN
  41.   u:=AllocMem(SIZE(u^),MemReqSet{public, memClear});
  42.   Assert(u#NIL,ADR('no mem for UCopList'));
  43.   UCopperListInit(u,16); (* Größe völlig egal! *)
  44.   RETURN u
  45. END MakeUCopList;
  46.  
  47. PROCEDURE FreeUCopList(VAR UPtr:UCopListPtr; u:UCopListPtr);
  48. VAR temp: UCopListPtr;
  49. BEGIN
  50.   Forbid;
  51.   temp:=ADR(UPtr); (* Trick: erster gleich UCopList (.next = erste Comp.!) *)
  52.   WHILE (temp#NIL) AND (temp^.next#u) DO
  53.     temp:=temp^.next;
  54.   END;
  55.   IF temp#NIL THEN
  56.     temp^.next:=temp^.next^.next; (* auslinken *)
  57.     FreeCopList(u^.firstCopList);
  58.     FreeMem(u,SIZE(u^));
  59.   END;
  60.   Permit;
  61. END FreeUCopList;
  62.  
  63. PROCEDURE LinkUCopList(VAR UPtr: UCopListPtr; u: UCopListPtr);
  64. VAR temp: UCopListPtr;
  65. BEGIN
  66.   Forbid;
  67.   IF UPtr=NIL THEN
  68.     UPtr:=u
  69.   ELSE
  70.     temp:=UPtr;
  71.     WHILE temp^.next#NIL DO
  72.       temp:=temp^.next
  73.     END;
  74.     temp^.next:=u;
  75.   END;
  76.   Permit;
  77. END LinkUCopList;
  78.  
  79. PROCEDURE AskValues;
  80. BEGIN
  81.   OwnS:=0;
  82.   WriteString('Own Screen (1=ja)?'); ReadInt(OwnS);
  83.   IF OwnS=1 THEN
  84.     WriteString('DEPTH?'); ReadInt(DEPTH);
  85.     WriteString('WIDTH?'); ReadInt(WIDTH);
  86.     WriteString('HEIGHT?'); ReadInt(HEIGHT);
  87.     WH:=HEIGHT-12;
  88.   END;
  89.   WriteString('Outputfile? ');
  90.   OpenOutput('');
  91. END AskValues;
  92.  
  93. BEGIN
  94.   AskValues;
  95.   IF OwnS#1 THEN
  96.     ActScreen:=OpenWorkBench();
  97.     WIDTH:=640; HEIGHT:=256; DEPTH:=2;
  98.   ELSE
  99.     OpenBackDrop(DEPTH,WIDTH,HEIGHT-12,ADR('meiner'));
  100.     Move(BdRp,0,0);
  101.     Draw(BdRp,WIDTH-1,WH-1);
  102.     Move(BdRp,0,0);
  103.     Draw(BdRp,WIDTH-1,0);
  104.     Draw(BdRp,WIDTH-1,WH-1);
  105.     Draw(BdRp,0,WH-1);
  106.     Draw(BdRp,0,0);
  107.     ActScreen:=BdScreen;
  108.   END;
  109.  
  110.   U:=MakeUCopList();
  111.   CWAIT(U,HEIGHT/4,10);
  112.   CMOVE(U,ADR(custom.color[0]),00F0H);
  113.   CWAIT(U,HEIGHT/2,20);
  114.   CWAIT(U,HEIGHT/2,20); (* Test auf doppeltes Wait *)
  115.   CMOVE(U,ADR(custom.color[0]),0F00H);
  116.   CWAIT(U,3*HEIGHT/4,20);
  117.   CMOVE(U,ADR(custom.color[0]),000FH);
  118.   CWAIT(U,3*HEIGHT/4,180);
  119.   CMOVE(U,ADR(custom.color[0]),0001H);
  120.   CWAIT(U,256,0);
  121.   CEND(U,0,0);
  122.   LinkUCopList(ActScreen^.viewPort.uCopIns,U);
  123.   RethinkDisplay;
  124.  
  125.   Delay(10*50);
  126.   ShowIt;
  127.   IF OwnS#1 THEN (* sonst automatisch! *)
  128.     FreeUCopList(ActScreen^.viewPort.uCopIns,U);
  129.     RethinkDisplay;
  130.   END;
  131.  
  132. (* CloseBackDrop; Rest vom SpeicherTest 
  133.   Delay(1*50);
  134.   Assert(AllocAbs(SIZE(U^),U)=U,ADR('UCopList nicht freigegeben!'));
  135.   FreeMem(U,SIZE(U^));
  136. *)
  137. END Copper.
  138.